01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23 |
|
' Suche1
With Tabelle1
ZeileOut = 1
For Zeile = 2 To .Cells(Rows.Count, "Q").End(xlUp).Row
If .Cells(Zeile, "Q").Value Like "Haus" Or _
.Cells(Zeile, "Q").Value Like "Baum" Then
.Rows(Zeile).Copy Destination:=Tabelle2.Rows(ZeileOut)
ZeileOut = ZeileOut + 1
End If
Next Zeile
End With
' Suche2
With Tabelle1
ZeileOut = 1
sSuch = ",Haus,Baum,Anderes,"
For Zeile = 2 To .Cells(Rows.Count, "Q").End(xlUp).Row
If InStr(1, sSuch, "," & .Cells(Zeile, "Q").Value & ",", vbTextCompare) > 0 Then
.Rows(Zeile).Copy Destination:=Tabelle2.Rows(ZeileOut)
ZeileOut = ZeileOut + 1
End If
Next Zeile
End With
|